home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d16
/
pchart.arc
/
PCHART.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-05-05
|
16KB
|
588 lines
{**************************************************}
{ Chart 1.0 }
{ Written in }
{ Turbo Pascal for Windows }
{ Copyright (c) 1991 }
{ Zack Urlocker }
{ 05/02/91 }
{**************************************************}
program PCharts;
{ This is a simple implementation of a charting program written
in Turbo Pascal for Windows using the ObjectWindows application
framework. The program is divided into several object types:
TChartApplication --creates and shows the main window
TChartDialog --allows editing of data items
TChartWindow --responds to Windows messages, menu commands,
keyboard and mouse events
TChart and descendants --chart objects that can draw, rescale etc
these are in the Charts unit
TDict and TAssoc --data management objects
these are in the Dicts unit
}
{$R PChart.res} { Link in resources }
{$IFDEF Final} { Remove debug code for final version}
{$D-,I-,L-,R-,S-}
{$ELSE}
{$D+,I+,L+,R+,S+}
{$ENDIF}
uses Dicts, WObjects, WinTypes, WinProcs, Strings, StdDlgs, Charts;
const
cm_New = 501; { Menu items }
cm_Open = 502;
cm_Save = 503;
cm_SaveAs = 504;
cm_Exit = 508;
cm_About = 509;
cm_HBar = 555;
cm_VBar = 556;
cm_V3DBar = 557;
cm_Pie = 558;
cm_Change = 552;
cm_SetName= 553;
cm_Help = 600;
cm_CmdMode= 601; { For Lotus style slash (/) key commands }
id_Label = 101; { Dialog box fields}
id_Value = 102;
id_Delete = 104;
fieldLen = 16;
type
{ The application defines startup behavior for the window. }
TChartApplication = object(TApplication)
procedure InitInstance; virtual;
procedure InitMainWindow; virtual;
end;
{ Dialog transfer record }
ItemTransferBuffer = record
LabelStr, ValueStr : array[0..FieldLen-1] of char;
end;
{ The dialog is used for input of new data items. }
PChartDialog = ^TChartDialog;
TChartDialog = object(TDialog)
LabelEdit, valueEdit : PEdit;
constructor Init(AParent: PWindowsObject; ATitle:PChar);
procedure Delete(var Msg:TMessage); virtual id_First + id_Delete;
end;
{ The window responds to messages and controls the game board. }
PChartWindow = ^TChartWindow;
TChartWindow = object(TWindow)
Name : PChar; { Name for file I/O }
Chart : PChart; { Pointer to a chartl }
Saved : Boolean; { has chart been saved? }
ItemBuffer : ItemTransferBuffer; { for ChartDialog }
constructor Init(AParent: PWindowsObject; ATitle: PChar);
procedure GetWindowClass(var WndClass: TWndClass); virtual;
procedure redraw;
function CanClose: Boolean; virtual;
procedure IOError(ErrMessage : PChar);
procedure SetCaption(FName : PChar);
function Read(fName : PChar): Boolean;
function Write(fName : PChar): Boolean;
{ menu response methods }
procedure NewFile(var Msg: TMessage); virtual cm_First + cm_New;
procedure Open(var Msg: TMessage); virtual cm_First + cm_Open;
procedure Save(var Msg: TMessage); virtual cm_First + cm_Save;
procedure SaveAs(var Msg: TMessage); virtual cm_First + cm_SaveAs;
procedure Exit(var Msg: TMessage); virtual cm_First + cm_Exit;
procedure HBar(var Msg: TMessage); virtual cm_First + cm_HBar;
procedure VBar(var Msg: TMessage); virtual cm_First + cm_VBar;
procedure V3DBar(var Msg: TMessage); virtual cm_First + cm_V3DBar;
procedure Pie(var Msg: TMessage); virtual cm_First + cm_Pie;
procedure Change(var Msg: TMessage); virtual cm_First + cm_Change;
procedure SetName(var Msg: TMessage); virtual cm_First + cm_SetName;
procedure About(var Msg: TMessage); virtual cm_First + cm_About;
procedure Help(var Msg: TMessage); virtual cm_First + cm_Help;
procedure CmdMode(var Msg: TMessage); virtual cm_First + cm_CmdMode;
{ windows message response methods }
procedure Paint(DC: HDC; var PaintInfo: TPaintStruct); virtual;
procedure wmSetFocus(var Msg: TMessage); virtual wm_SetFocus;
procedure wmKillFocus(var Msg: TMessage); virtual wm_KillFocus;
procedure wmLButtonDown(var Msg: TMessage); virtual wm_LButtonDown;
procedure wmKeyDown(var Msg: TMessage); virtual wm_KeyDown;
procedure wmSize(var Msg: TMessage); virtual wm_Size;
end;
{--------------------------------------------------}
{ TChartApplication's method implementations: }
{--------------------------------------------------}
{ Load the accelerator table for hotkeys }
procedure TChartApplication.InitInstance;
begin
Tapplication.InitInstance;
HAccTable := LoadAccelerators(HInstance, 'ChartKeys');
end;
{ Start the main window }
procedure TChartApplication.InitMainWindow;
begin
MainWindow := New(PChartWindow,
Init(nil, 'PChart : (untitled)'));
end;
{--------------------------------------------------}
{ TChartDialog method implementations: }
{--------------------------------------------------}
{ The edit controls will contain the transfer data. }
constructor TChartDialog.Init(AParent: PWindowsObject; ATitle:PChar);
begin
TDialog.Init(AParent, ATitle);
new(LabelEdit, initResource(@Self, id_Label, fieldLen));
new(ValueEdit, initResource(@Self, id_Value, fieldLen));
end;
{ Respond to Delete Button by transfering data out.
This is automatically done if the user presses Ok. }
procedure TChartDialog.Delete(var Msg:TMessage);
begin
TransferData(tf_GetData);
EndDlg(id_Delete);
end;
{--------------------------------------------------}
{ TChartWindow's method implementations: }
{--------------------------------------------------}
{ Initialize all fields to starting values }
constructor TChartWindow.Init(AParent: PWindowsObject; ATitle: PChar);
var Msg : TMessage;
begin
TWindow.Init(AParent, ATitle);
Chart := new(PVbarChart, init);
Saved := True;
getMem(Name, 255);
StrPcopy(ItemBuffer.LabelStr, 'Item');
StrPCopy(ItemBuffer.ValueStr, '50');
redraw;
with attr do
begin
w:=400; { Force window size }
h:=300;
end;
end;
{ Override default cursor, icon, menu }
procedure TChartWindow.GetWindowClass(var WndClass: TWndClass);
begin
TWindow.GetWindowClass(WndClass);
WndClass.Style := 0;
WndClass.hCursor := LoadCursor(hInstance, 'ChartCur');
WndClass.hIcon := LoadIcon(hInstance, 'ChartIco');
WndClass.lpszMenuName := 'ChartMenu';
end;
{ Update the chart by rescaling, redrawing }
procedure TChartWindow.redraw;
begin
Chart^.area.x := attr.w;
Chart^.area.y := attr.h;
Chart^.reScale;
invalidateRect(HWindow, nil, True);
end;
{ Make sure the user has saved his work before closing }
function TChartWindow.CanClose: Boolean;
var Reply : Integer;
Msg : TMessage;
begin
if not Saved then
begin
Reply := MessageBox(HWindow, 'File has not been saved. Save file before closing?',
'Warning', mb_IconStop or mb_YesNoCancel);
if Reply = id_Yes then
Save(Msg);
end;
CanClose := Saved or (Reply <> id_Cancel);
end;
{ Create a New chart }
procedure TChartWindow.NewFile(var Msg: TMessage);
begin
Chart := new(PVbarChart, init);
Saved := True;
StrDispose(Name);
GetMem(Name, 255);
setName(Msg);
StrPcopy(ItemBuffer.LabelStr, 'Item');
StrPCopy(ItemBuffer.ValueStr, '50');
redraw;
end;
{ Open a chart file }
procedure TChartWindow.Open(var Msg: TMessage);
var FName : PChar;
begin
GetMem(FName, 255);
strPCopy(FName, '*.cht');
if application^.execDialog(New(PFileDialog,
init(@Self, PChar(sd_FileOpen), FName))) = ID_Ok then
begin
Chart := new(PChart, init);
StrCopy(Name, FName);
if Read(FName) then
redraw
else
newFile(Msg);
end;
Strdispose(FName);
end;
{ Save the chart with existing name. Call SaveAs if necessary. }
procedure TChartWindow.Save(var Msg: TMessage);
begin
if strScan(Name, '.') = nil then
strCat(Name, '.cht');
if strLen(Name) > 4 then
write(Name)
else
SaveAs(Msg);
end;
{ Save the chart under a new name }
procedure TChartWindow.SaveAs(var Msg: TMessage);
var len : Integer;
OldName : PChar; { in case user cancels command }
begin
getMem(OldName, 255);
strCopy(OldName, Name);
{ give a default name and extension }
if strLen(Name) = 0 then
begin
len := StrLen(Chart^.Name);
if len > 8 then len := 8;
StrLCopy(Name, Chart^.Name, len);
end;
if StrScan(Name, '.') = nil then
StrCat(Name, '.cht');
if StrLen(Name) < 5 then
StrPCopy(Name, 'Chart.cht');
if application^.execDialog(New(PFileDialog,
init(@Self, PChar(sd_FileSave), Name))) = ID_Ok then
write(Name)
else
StrCopy(Name, OldName);
strDispose(OldName);
end;
{ Report an I/O Error }
procedure TChartWindow.IOError(ErrMessage : PChar);
var Msg : Array[0..255] of Char;
begin
MessageBeep(0);
strCopy(Msg, ErrMessage);
MessageBox(0, StrCat(Msg, Name), 'File Error', mb_IconExclamation);
end;
{ Set the caption of the window to the filename }
procedure TChartWindow.SetCaption(FName : PChar);
var Caption : PChar;
begin
getMem(Caption, 255);
strPCopy(Caption, 'PChart : ');
SetWindowText(Hwindow, strCat(Caption, FName));
strDispose(Caption);
end;
{ Read a chart from a file. }
function TChartWindow.Read(FName : PChar) : Boolean;
var S : TBufStream;
begin
S.Init(FName, StOpenRead, 1024);
if S.Status <> stOk then
IOError('Can''t open file ')
else
begin
Chart := PChart(S.Get);
if S.Status <> stOk then
IOError('Can''t read file ')
else
setCaption(Name);
end;
S.Done;
Read := (S.Status = stOk);
end;
{ Store a chart onto a file by storing onto a stream. }
function TChartWindow.Write(FName : PChar) : Boolean;
var S : TBufStream;
begin
S.Init(FName, stCreate, 1024);
if S.Status <> stOk then
IOError('Can''t create file ')
else
begin
S.put(Chart);
if S.Status <> stOk then
IOError('Can''t write file ')
else
begin
setCaption(Name);
Saved := True;
end;
end;
S.Done;
Write := (S.status = StOk);
end;
{ Make it a Horizontal Bar chart }
procedure TChartWindow.HBar(var Msg: TMessage);
Var Chart2 : PChart;
begin
Chart2 := new(PHBarChart, init);
Chart2^.Items := Chart^.items;
Chart2^.Name := Chart^.Name;
Chart := PHBarChart(Chart2);
redraw;
end;
{ Make it a Vertical Bar chart }
procedure TChartWindow.VBar(var Msg: TMessage);
Var Chart2 : PChart;
begin
Chart2 := new(PVBarChart, init);
Chart2^.Items := Chart^.items;
Chart2^.Name := Chart^.Name;
Chart := PVBarChart(Chart2);
redraw;
end;
{ Make it a Vertical Bar chart }
procedure TChartWindow.V3DBar(var Msg: TMessage);
Var Chart2 : PChart;
begin
Chart2 := new(PV3DBarChart, init);
Chart2^.Items := Chart^.items;
Chart2^.Name := Chart^.Name;
Chart := PV3DBarChart(Chart2);
redraw;
end;
{ Make it a Pie chart }
procedure TChartWindow.Pie(var Msg: TMessage);
Var Chart2 : PChart;
begin
Chart2 := new(PPieChart, init);
Chart2^.Items := Chart^.items;
Chart2^.Name := Chart^.Name;
Chart := PPieChart(Chart2);
redraw;
end;
{ Change, add or delete an item }
procedure TChartWindow.Change(var Msg: TMessage);
var Dlg: TChartDialog;
Reply, Value, errorPos : Integer;
begin
Dlg.Init(@Self, 'ChartDlg');
Dlg.TransferBuffer := @ItemBuffer;
Reply := Dlg.Execute;
Dlg.Done;
if Reply = id_Ok then
begin
{ If valid, add the item to the chart }
val(ItemBuffer.ValueStr, value, errorPos);
if errorPos = 0 then
begin
if Chart = nil then
Chart := new(PVBarChart, init);
Chart^.add(ItemBuffer.LabelStr, Value);
end
else
MessageBeep(0);
end
else if Reply = id_Delete then
if Chart = nil then
MessageBeep(0)
else
Chart^.Remove(ItemBuffer.LabelStr);
{ Adjust the chart }
if Reply <> id_Cancel then
begin
redraw;
Saved := False;
end;
end;
{ Set or change the name of the chart }
procedure TChartWindow.SetName(var Msg: TMessage);
var TempName : PChar;
begin
GetMem(TempName, 40);
if Chart^.Name <> nil then
strLCopy(TempName, Chart^.Name, 40);
if application^.ExecDialog(New(PInputDialog,
Init(@Self, 'Chart', 'Enter chart name:',
TempName, 40))) = id_Ok then
begin
if chart^.Name <> nil then
strDispose(Chart^.Name);
getMem(Chart^.Name, 40);
strCopy(Chart^.Name, TempName);
redraw;
end;
strDispose(TempName);
end;
{ Display About box }
procedure TChartWindow.About(var Msg: TMessage);
var Dlg: TDialog;
begin
Dlg.Init(@Self, 'AboutDlg');
Dlg.Execute;
Dlg.Done;
end;
{ Display Help dialog }
procedure TChartWindow.Help(var Msg: TMessage);
var Dlg: TDialog;
begin
Dlg.Init(@Self, 'HelpDlg');
Dlg.Execute;
Dlg.Done;
end;
{ Respond to Lotus style commands from slash (/) accelerator }
procedure TChartWindow.CmdMode(var Msg: TMessage);
begin
sendMessage(HWindow, WM_SYSCOMMAND, $F100, 0);
end;
{ Exit the program }
procedure TChartWindow.Exit(var Msg: TMessage);
begin
if CanClose then postQuitMessage(0);
end;
{ Draw the chart if it exists }
procedure TChartWindow.Paint(DC: HDC; var PaintInfo: TPaintStruct);
var s : array[0..16] of Char;
begin
if Chart <> nil then
Chart^.draw(DC)
else
begin
strPCopy(s, 'Error: No chart');
TextOut(DC, 10, 10, s, strLen(s));
end;
end;
{ Ensure that cursor is visible even when no mouse }
procedure TChartWindow.wmSetFocus(var Msg: TMessage);
begin
ShowCursor(True);
end;
{ Return cursor to previous state for other windows }
procedure TChartWindow.wmKillFocus(var Msg: TMessage);
begin
ShowCursor(False);
end;
{ Select and item in the chart and edit it }
procedure TChartWindow.wmLButtonDown(var Msg: TMessage);
var Item : PAssoc;
S : String;
begin
{ First locate the item clicked on }
Item := Chart^.getItem(Msg.LParamLo, Msg.LParamHi);
if Item <> nil then
begin
{ Update the edit buffer and edit }
strLCopy(ItemBuffer.LabelStr, Item^.key, fieldLen-1);
str(Item^.value,S);
strPCopy(ItemBuffer.ValueStr, S);
Change(Msg);
end
else
MessageBeep(0);
end;
{ Simulate mouse movement with cursor keys }
procedure TChartWindow.wmKeyDown(var Msg: TMessage);
var x, y : Integer;
pos : TPoint;
key : word;
begin
{ Determine position of cursor in Window }
getCursorPos(pos);
screenToClient(HWindow, pos);
x:=pos.x;
y:=pos.y;
{ move the cursor position }
key := Msg.WParam;
case key of
VK_UP : y := y - 10;
VK_DOWN : y := y + 10;
VK_RIGHT : x := x + 10;
VK_LEFT : x := x - 10;
VK_HOME :
begin
x := 10;
y := 10;
end;
VK_END :
begin
x := attr.w - 10;
y := attr.h - 10;
end;
VK_RETURN,
VK_SPACE,
VK_F2:
begin
{ Simulate mouse pressing at cursor position }
Msg.LParam := LongInt(pos);
wmLButtonDown(Msg);
end;
end;
{ Update position of cursor in window with clipping }
if x < 1 then x := 10;
if y < 1 then y := 10;
if x >= attr.w then x:= attr.w - 10;
if y >= attr.h then y:= attr.h - 10;
pos.x := x;
pos.y := y;
clientToScreen(HWindow, pos);
setCursorPos(pos.x, pos.y);
end;
{ update internal information when resizing then redraw }
procedure TChartWindow.wmSize(var Msg: TMessage);
begin
attr.h := Msg.lParamHi;
attr.w := Msg.lParamLo;
redraw
end;
{--------------------------------------------------}
{ Main program: }
{--------------------------------------------------}
var
ChartApp: TChartApplication;
begin
ChartApp.Init('PChart');
ChartApp.Run;
ChartApp.Done;
end.